Private Sub CommandButton2_Click() Dim n As Integer Dim i As Integer Dim s As Single n = InputBox("班级", "输入班级") '筛选出n班 Sheets("sheet1").Select Sheets("sheet1").Range("A2").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:=Str(n) Range("A1:" & "M" & [B65536].End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select

Selection.Copy Sheets.Add ActiveSheet.Name = Str(n) ActiveSheet.Paste Worksheets(Str(n)).Activate '激活新建的工作表 Sheets(Str(n)).Select Sheets(Str(n)).Range("1:1").Value = "" '给新建的工作表的第一行清空 Sheets(Str(n)).Range("A1").Value = Str(n) + "班" i = Sheets(Str(n)).Range("a65536").End(xlUp).Row s = WorksheetFunction.Count(Sheets(Str(n)).Range("d3:d" & i)) 'n班语文各科的等级人数 Sheets(Str(n)).Range("d2").Select '选择d2列，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("d2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction cha = .CountIf(Sheets(Str(n)).Range("d3:d" & i), ">=" & chmarka) chb = .CountIf(Sheets(Str(n)).Range("d3:d" & i), ">=" & chmarkb) - cha chc = .CountIf(Sheets(Str(n)).Range("d3:d" & i), ">=" & chmarkc) - cha - chb chd = .CountIf(Sheets(Str(n)).Range("d3:d" & i), ">=" & chmarkd) - cha - chb - chc che = .CountIf(Sheets(Str(n)).Range("d3:d" & i), ">=" & chmarke) - cha - chb - chc - chd End With Subject = Sheets(Str(n)).Range("d2").Value chvalue = (cha * 6 + chb * 4 + chc * 3 + chd + che * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 1, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 1, 2) = chvalue '数学 Sheets(Str(n)).Range("e2").Select '选择F2单元格,排序 Selection.Sort Key1:=Sheets(Str(n)).Range("e2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction mata = .CountIf(Sheets(Str(n)).Range("e3:e" & i), ">=" & matmarka) matb = .CountIf(Sheets(Str(n)).Range("e3:e" & i), ">=" & matmarkb) - mata matc = .CountIf(Sheets(Str(n)).Range("e3:e" & i), ">=" & matmarkc) - mata - matb matd = .CountIf(Sheets(Str(n)).Range("e3:e" & i), ">=" & matmarkd) - mata - matb - matc mate = .CountIf(Sheets(Str(n)).Range("e3:e" & i), ">=" & matmarke) - mata - matb - matc - matd End With Subject = Sheets(Str(n)).Range("e2").Value matvalue = (mata * 6 + matb * 4 + matc * 3 + matd + mate * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 2, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 2, 2) = matvalue '英语 Sheets(Str(n)).Range("F2").Select '选择F2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("F2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction enga = .CountIf(Sheets(Str(n)).Range("f3:f" & i), ">=" & engmarka) engb = .CountIf(Sheets(Str(n)).Range("f3:f" & i), ">=" & engmarkb) - enga engc = .CountIf(Sheets(Str(n)).Range("f3:f" & i), ">=" & engmarkc) - enga - engb engd = .CountIf(Sheets(Str(n)).Range("f3:f" & i), ">=" & engmarkd) - enga - engb - engc enge = .CountIf(Sheets(Str(n)).Range("f3:f" & i), ">=" & engmarke) - enga - engb - engc - engd End With Subject = Sheets(Str(n)).Range("f2").Value engvalue = (enga * 6 + engb * 4 + engc * 3 + engd + enge * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 3, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 3, 2) = engvalue '物理 If Range("g3").Value "" Then Sheets(Str(n)).Range("g2").Select '选择F2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("g2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction phya = .CountIf(Sheets(Str(n)).Range("g3:g" & i), ">=" & phymarka) phyb = .CountIf(Sheets(Str(n)).Range("g3:g" & i), ">=" & phymarkb) - phya phyc = .CountIf(Sheets(Str(n)).Range("g3:g" & i), ">=" & phymarkc) - phya - phyb phyd = .CountIf(Sheets(Str(n)).Range("g3:g" & i), ">=" & phymarkd) - phya - phyb - phyc phye = .CountIf(Sheets(Str(n)).Range("g3:g" & i), ">=" & phymarke) - phya - phyb - phyc - phyd End With Subject = Sheets(Str(n)).Range("g2").Value phyvalue = (phya * 6 + phyb * 4 + phyc * 3 + phyd + phye * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 4, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 4, 2) = phyvalue Else MsgBox "结束" End If '化学 If Range("h3").Value "" Then Sheets(Str(n)).Range("h2").Select '选择h2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("h2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction chea = .CountIf(Sheets(Str(n)).Range("h3:h" & i), ">=" & chemarka) cheb = .CountIf(Sheets(Str(n)).Range("h3:h" & i), ">=" & chemarkb) - chea chec = .CountIf(Sheets(Str(n)).Range("h3:h" & i), ">=" & chemarkc) - chea - cheb ched = .CountIf(Sheets(Str(n)).Range("h3:h" & i), ">=" & chemarkd) - chea - cheb - chec chee = .CountIf(Sheets(Str(n)).Range("h3:h" & i), ">=" & chemarke) - chea - cheb - chec - ched End With Subject = Sheets(Str(n)).Range("h2").Value chevalue = (chea * 6 + cheb * 4 + chec * 3 + ched + chee * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 5, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 5, 2) = chevalue Else MsgBox "结束" End If '生物 If Range("i3").Value "" Then Sheets(Str(n)).Range("i2").Select '选择i2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("i2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction bioa = .CountIf(Sheets(Str(n)).Range("i3:i" & i), ">=" & biomarka) biob = .CountIf(Sheets(Str(n)).Range("i3:i" & i), ">=" & biomarkb) - bioa bioc = .CountIf(Sheets(Str(n)).Range("i3:i" & i), ">=" & biomarkc) - bioa - biob biod = .CountIf(Sheets(Str(n)).Range("i3:i" & i), ">=" & biomarkd) - bioa - biob - bioc bioe = .CountIf(Sheets(Str(n)).Range("i3:i" & i), ">=" & biomarke) - bioa - biob - bioc - biod End With Subject = Sheets(Str(n)).Range("i2").Value biovalue = (bioa * 6 + biob * 4 + bioc * 3 + biod + bioe * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 6, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 6, 2) = biovalue Else MsgBox "结束" End If '政治 If Range("j3").Value "" Then Sheets(Str(n)).Range("j2").Select '选择i2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("j2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction polia = .CountIf(Sheets(Str(n)).Range("j3:j" & i), ">=" & polimarka) polib = .CountIf(Sheets(Str(n)).Range("j3:j" & i), ">=" & polimarkb) - polia polic = .CountIf(Sheets(Str(n)).Range("j3:j" & i), ">=" & polimarkc) - polia - polib polid = .CountIf(Sheets(Str(n)).Range("j3:j" & i), ">=" & polimarkd) - polia - polib - polic polie = .CountIf(Sheets(Str(n)).Range("j3:j" & i), ">=" & polimarke) - polia - polib - polic - polid End With Subject = Sheets(Str(n)).Range("j2").Value polivalue = (polia * 6 + polib * 4 + polic * 3 + polid + polie * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 7, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 7, 2) = polivalue Else MsgBox "结束" End If '历史 If Range("k3").Value "" Then Sheets(Str(n)).Range("k2").Select '选择k2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("k2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction hisa = .CountIf(Sheets(Str(n)).Range("k3:k" & i), ">=" & hismarka) hisb = .CountIf(Sheets(Str(n)).Range("k3:k" & i), ">=" & hismarkb) - hisa hisc = .CountIf(Sheets(Str(n)).Range("k3:k" & i), ">=" & hismarkc) - hisa - hisb hisd = .CountIf(Sheets(Str(n)).Range("k3:k" & i), ">=" & hismarkd) - hisa - hisb - hisc hise = .CountIf(Sheets(Str(n)).Range("k3:k" & i), ">=" & hismarke) - hisa - hisb - hisc - hisd End With Subject = Sheets(Str(n)).Range("k2").Value hisvalue = (hisa * 6 + hisb * 4 + hisc * 3 + hisd + hise * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 8, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 8, 2) = hisvalue Else MsgBox "结束" End If '地理 If Range("l3").Value "" Then Sheets(Str(n)).Range("l2").Select '选择k2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("l2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction geoa = .CountIf(Sheets(Str(n)).Range("l3:l" & i), ">=" & geomarka) geob = .CountIf(Sheets(Str(n)).Range("l3:l" & i), ">=" & geomarkb) - geoa geoc = .CountIf(Sheets(Str(n)).Range("l3:l" & i), ">=" & geomarkc) - geoa - geob geod = .CountIf(Sheets(Str(n)).Range("l3:l" & i), ">=" & geomarkd) - geoa - geob - geoc geoe = .CountIf(Sheets(Str(n)).Range("l3:l" & i), ">=" & geomarke) - geoa - geob - geoc - geod End With Subject = Sheets(Str(n)).Range("l2").Value geovalue = (geoa * 6 + geob * 4 + geoc * 3 + geod + geoe * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 9, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 9, 2) = geovalue Else MsgBox "结束" End If '总分 If Range("m3").Value "" Then Sheets(Str(n)).Range("m2").Select '选择m2单元格，排序 Selection.Sort Key1:=Sheets(Str(n)).Range("m2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin With WorksheetFunction suma = .CountIf(Sheets(Str(n)).Range("m3:m" & i), ">=" & geomarka) sumb = .CountIf(Sheets(Str(n)).Range("m3:m" & i), ">=" & summarkb) - suma sumc = .CountIf(Sheets(Str(n)).Range("m3:m" & i), ">=" & summarkc) - suma - sumb sumd = .CountIf(Sheets(Str(n)).Range("m3:m" & i), ">=" & summarkd) - suma - sumb - sumc sume = .CountIf(Sheets(Str(n)).Range("m3:m" & i), ">=" & summarke) - suma - sumb - sumc - sumd End With Subject = Sheets(Str(n)).Range("m2").Value sumvalue = (suma * 6 + sumb * 4 + sumc * 3 + sumd + sume * (-1)) / s '均量值 Sheets(Str(n)).Cells(i + 10, 1) = Subject + "均量值:" Sheets(Str(n)).Cells(i + 10, 2) = sumvalue Else MsgBox "结束" End IfEnd Sub